home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / CGI shell / Pocket 6.4 / Source / Interpreter.txt < prev    next >
Text File  |  1993-06-25  |  3KB  |  107 lines

  1. ; Interpreter.txt 8:12:05 AM  2/11/87
  2. ; add Held 2:45:49 PM  5/31/87
  3. ; v 0.3 DA compatable 11:47:16 AM  1/21/88
  4. ; add startup routine 9:45:00 AM 3/30/88
  5. ; Mon Apr 25, 1988 15:12:04 macros
  6. ; Wed Apr 27, 1988 12:30:48 v 0.4
  7. ; Mon Jun 03, 1991 23:40:00 restructure
  8. ; Wed Apr 01, 1992 00:11:00 remove uflow, add stackSize, numError
  9. ; Sun Apr 12, 1992 22:46:00 add fp routines, move user vars to asupport
  10. ; Mon Apr 19, 1993 22:58:00 add \
  11. ; Fri Jun 11, 1993 01:31:00 move dictionary parts to 'dictionary.txt'
  12.  
  13.  
  14. Cold:    LEA    Bottom,BP        ; setup BP  [a3]
  15.     MOVE.L    A1,Expand-Base(BP)    ; address of routine in CODE 1
  16.  
  17.     ; setup the stacks, PS and RS [a6 & a7]
  18.     LEA    IntA7-Base(BP),A0    ; A7 is already where it should be.
  19.     MOVE.L    RS,(A0)+        ; Save initial value of RS at IntA7
  20.     MOVEA.L    RS,PS
  21.     SUBA.W    stackSize-base(BP),RS    ; variable stack size added 3/30/92
  22.     MOVE.L    RS,(A0)+        ; save return stack bottom at Rzero
  23.     SUBQ.L    #8,PS            ; leave room for under flow ...
  24.     SUBQ.L    #2,PS            ; ... leave _plenty_ of room
  25.     MOVE.L    PS,(A0)            ; Put parameter stack bot. at Szero
  26.  
  27.     ; setup DP  [a2]
  28.     MOVE    FreePt-Base(BP),D0    ; rel compile buffer pointer
  29.     LEA    0(BP,D0.W),DP        ; abs addr into DP register
  30.  
  31.     ; setup Dict [d6]
  32.     CLR.L    Dict
  33.     MOVE    DictPt-base(BP),Dict    ; rel.addr of the last dict. entry
  34.  
  35.     ; set the dictionary size
  36.     MOVE    freesz-base(BP),-(PS)
  37.     JSR    grow-base(BP)
  38.  
  39.     ; setup the interface
  40.     JSR    MacStart-base(BP)    ; moved 6/3/91
  41.  
  42. Warm:    MOVEA.L    Rzero-Base(BP),RS    ; reset return stack
  43.     MOVEA.L    Szero-Base(BP),PS    ; reset parameter stack
  44.     JSR    page-Base(BP)        ; clear the page
  45.     MOVE    newer-base(BP),D0
  46.     JSR    0(BP,D0.W)        ; run the startup routine
  47.     CLR.L    fcolon-base(BP)
  48.     BSET.B    #7,fint-base(BP)
  49. Restart:
  50.     BSR.S    GetInput        ; fill the tib with a line of input
  51. Main:    JSR    token-Base(BP)        ; get the next word of the line
  52.     MOVE    Dict,-(PS)        ; push pointer to last name
  53.     JSR    search-Base(BP)        ; find current token in dictionary
  54.     TST    (PS)+            ; found NOT IF,
  55.     BEQ.S    TestNum            ; ... assume its a number
  56.     BCLR    #7,fimmed-base(BP)    ; ELSE, immediate? IF
  57.     BNE.S    doex            ; ... do it
  58.     TST.B    fcolon-base(BP)        ; ELSE, compiling? NOT IF,
  59.     BEQ.S    doex            ; ... do it
  60.     BCLR    #7,fmacro-base(BP)    ; ELSE, macro? IF
  61.     BNE.S    domc
  62.     JSR    Compile-base(BP)    ; ELSE, compile a JSR to it
  63.     BRA.S    Main
  64.  
  65.   doex:    JSR    Execute-base(BP)
  66.     JSR    StkChk-base(BP)
  67.     BRA.S    Main
  68.  
  69.   domc:    JSR    mcomp-base(BP)
  70.     BRA.S    Main
  71.     
  72.   TestNum:    ; Test the token for integer or floating point numberness.
  73.     JSR    here-base(BP)        ; get the relative address of token
  74.     JSR    number-base(BP)        ; convert it to a value, if posible
  75.     TST    (PS)+            ;  was it?
  76.     BEQ.S    testfloat        ; if not, test for floating point
  77.     TST.B    fcolon-base(BP)        ; else, are you compiling?
  78.     BEQ.S    Main            ; if not, leave it on the stack
  79.     JSR    Literal-base(BP)    ; else, compile it as a literal
  80.     BRA.S    Main            ; then, get on with it
  81.  
  82.     TestFloat:    ; It's not an integer, try floating point.
  83.     BCLR    #7,fneg-base(BP)    ; Is it a negative number?
  84.     BEQ.S    @0
  85.     MOVE.B    #$2D,1(A2)        ; put in a negative sign
  86.     @0:    MOVE.L    A2,-(PS)
  87.     JSR    fnum-base(BP)        ; do the conversion (handles error)
  88.     TST.B    fcolon-base(bp)        ; if compiling, leave ...
  89.     BEQ.S    Main            ; ... it on the stack.
  90.     JSR    flit-base(BP)        ; else flit it
  91.     BRA.S    Main
  92.  
  93. GetInput:
  94.     TST.B    fint-base(BP)
  95.     BEQ    Pasting            ; Get a line from scrap data
  96.     TST.B    fcolon-base(BP)
  97.     BNE.S    Line
  98.     JSR    Prompt-Base(BP)
  99.     BRA.S    Line
  100.     
  101. Line:    JSR    ClearTermBuf-base(BP)
  102.     MOVE    #termbuf-base,-(PS)
  103.     MOVE    #80,-(PS)
  104.     JMP    expect-base(BP)
  105.  
  106. ;   -----    Dictionary Follows ----------
  107.